home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / os2 / kzr0597.zip / GA.CMD < prev    next >
OS/2 REXX Batch file  |  1997-02-09  |  10KB  |  206 lines
  1. /* REXX-Programm ga.CMD  Gammafunktion.  */
  2.  
  3.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  4.    Call SysLoadFuncs
  5. /*   Signal on syntax name gaMsg */ /* hier ändern */
  6.  
  7. /* Diese Variablen müssen für jede Prozedur definiert werden, damit die  */
  8. /* Prozedur die Variable bufND kennt und die Variable ND übernehmen kann.*/
  9.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  10.    lp=LastPos("\", Pfd)
  11.    Pfd=DelStr(Pfd, 1+lp)
  12.    NDAga=Pfd||"NDAga.DAT"  /* hier ändern */
  13.    bufND  =Pfd||"NDZahl.DAT"
  14.    bufMsg =Pfd||"Meldung.DAT"
  15.    ND = LineIn(bufND, 1)
  16.  
  17.    if ND > 50 then
  18.    do
  19.      ND=50
  20.      call charout(NDAga) ; Call SysFileDelete NDAga
  21.      ret=LineOut(NDAga, 50)
  22.      Call Charout,"   Achtung, nur  50 Dezimalstellen bei der Berechnung von  ga(...)"
  23.      say
  24.      Beep(444, 200); Beep(628,300)  /* Hier kein EXIT ! */
  25.    end
  26.  
  27.    /* Wenn ND <= 64 ist, wird ND = ND  weitergegeben */
  28.    call charout(NDAga) ; Call SysFileDelete NDAga
  29.    ret=LineOut(NDAga, ND)
  30.  
  31.    /* Hier offenbar erforderlich wegen der hohen Stellenzahl der Konstanten. */
  32.    NUMERIC DIGITS 90  /* Beispiele für Konstanten */
  33.    c.1  = +1
  34.    c.2  = +0.577215664901532860606512090082402431042159335939923598805767234884867726777664670937
  35.    c.3  = -0.655878071520253881077019515145390481279766380478584347292362445683870838353722115169
  36.    c.4  = -0.042002635034095235529003934875429818711394500401106093522065812976180096875975992828
  37.    c.5  = +0.166538611382291489501700795102105235717781502247174340570468903178993866056474270428
  38.    c.6  = -0.042197734555544336748208301289187391301652684189822486376918873275459011185588987857
  39.    c.7  = -0.009621971527876973562114921672348198975362942252113002105138862627311673514460748057
  40.    c.8  = +0.007218943246663099542395010340446572709904800880238318001094781173622594974158536044
  41.    c.9  = -0.001165167591859065112113971084018388666809333795384057443407505275620025848166554809
  42.    c.10 = -0.215241674114950972815729963053647806478241923378338750350267489085639463716794790E-3
  43.    c.11 = +0.128050282388116186153198626328164323394892099693677214900545838041203552043479432E-3
  44.    c.12 = -0.20134854780788238655689391421021818382294833297979115261162670908229186188974321E-4
  45.    c.13 = -0.1250493482142670657345359473833092242322655621153959815349923157491212455619465E-5
  46.    c.14 = +0.1133027231981695882374129620330744943324004838621075654295505395460408427300846E-5
  47.    c.15 = -0.205633841697760710345015413002057283651257902629337945346831725332456803677140E-6
  48.    c.16 = +0.6116095104481415817862498682855342867275865719712320867324029277235074371825E-8
  49.    c.17 = +0.5002007644469222930055665048059991303044612742494481718953378877374721307221E-8
  50.    c.18 = -0.1181274570487020144588126565436505577738759504932587590961892631696433908487E-8
  51.    c.19 = +0.104342671169110051049154033231225019140070982312581212108710739273475883450E-9
  52.    c.20 = +0.7782263439905071254049937311360777226068086181392938819435507326929867498E-11
  53.    c.21 = -0.3696805618642205708187815878085766236570963451360995136484546554430003231E-11
  54.    c.22 = +0.510037028745447597901548132286323180272688606970763211735010485657351901E-12
  55.    c.23 = -0.20583260535665067832224295448552374197460910808101471880581964443490807E-13
  56.    c.24 = -0.5348122539423017982370017318727939948989715478120682111680954932114273E-14
  57.    c.25 = +0.1226778628238260790158893846622422428165455750456321366011359996084009E-14
  58.    c.26 = -0.118125930169745876951376458684229783121155729180484787983750812319057E-15
  59.    c.27 = +0.1186692254751600332579777242928674071088494079664827110740061069760E-17
  60.    c.28 = +0.1412380655318031781555803947566709037086350750334525625641222624694E-17
  61.    c.29 = -0.229874568443537020659247858063369926028450593141903670148898286642E-18
  62.    c.30 = +0.17144063219273374333839633702672570668126560625174331746498588308E-19
  63.    c.31 = +0.133735173049369311486478139512226802287505947176189478985818939E-21
  64.    c.32 = -0.205423355176667278932502535135573379668203793523873641273007117E-21
  65.    c.33 = +0.27360300486079998448315099043309820148653116958363633701669795E-22
  66.    c.34 = -0.1732356445910516639057428451564779799069749108794998413766676E-23
  67.    c.35 = -0.23606190244992872873434507354275310079264135521453704860562E-25
  68.    c.36 = +0.18649829417172944307184131618786668989458684290736682328610E-25
  69.    c.37 = -0.2218095624207197204399716913626860379731779500675675809751E-26
  70.    c.38 = +0.129778197494799366882441448633059416561949986463913317193E-27
  71.    c.39 = +0.1180697474966528406222745415509971518559684637841594596E-29
  72.    c.40 = -0.1124584349277088090293654674261439512119411795583008206E-29
  73.    c.41 = +0.127708517514086620399020667775112464774877206560051803E-30
  74.    c.42 = -0.7391451169615140823461289330108552823710568992445898E-32
  75.    c.43 = +0.11347502575542157609541652594693063930086121953326E-34
  76.    c.44 = +0.46391346410587220299448049079522284630579686795706E-34
  77.    c.45 = -0.5347336818439198875077418196709893320904885913120E-35
  78.    c.46 = +0.320799592361335262286123727908279439109014630583E-36
  79.    c.47 = -0.4445829736550756882101590352124643637401430593E-38
  80.    c.48 = -0.1311174518881988712901058494389922190236626122E-38
  81.    c.49 = +0.164703335254381388681825932790639414539953401E-39
  82.    c.50 = -0.10562331785035812186005610715382850499973709E-40
  83.    c.51 = +0.267844298264304947835496307189085194852391E-42
  84.    c.52 = +0.24247154948517826896730329383709212404954E-43
  85.    c.53 = -0.3736587834535612554034559121270316378515E-44
  86.    c.54 = +0.262833298094019544908903761187363931565E-45
  87.    c.55 = -0.9298175995376886299601668991518164566E-47
  88.    c.56 = -0.232794241869947059860426205562226943E-48
  89.    c.57 = +0.61696208352443874203544317731506464E-49
  90.    c.58 = -0.4928295586770989930504458682209762E-50
  91.    c.59 = +0.218351318341451069727782849863970E-51
  92.    c.60 = -0.1218722189147516555250452609259E-53
  93.    c.61 = -0.711710884166287463194565265340E-54
  94.    c.62 = +0.69205040543286892535284226555E-55
  95.    c.63 = -0.3676438468356676327679747226E-56
  96.    c.64 = +0.85630980562756543279818817E-58
  97.    c.65 = +0.4963045428366844384839756E-59
  98.    c.66 = -0.715429457708161521818575E-60
  99.    c.67 = +0.45517276890885041138065E-61
  100.    c.68 = -0.1618399305320294461039E-62
  101.    c.69 = -0.3818043424399946698E-65
  102.    c.70 = +0.5185052411905838705E-65
  103.    c.71 = -0.416713680922385348E-66
  104.    c.72 = +0.19162906929376614E-67
  105.    c.73 = -0.38089281324981E-69
  106.    c.74 = -0.2206386105545E-70
  107.    c.75 = +0.277223109628E-71
  108.    c.76 = -0.15987660491E-72
  109.    c.77 = +0.531973079E-74
  110.    c.78 = -0.805174E-77
  111.    c.79 = -0.12485E-76
  112.    c.80 = +0.964E-78
  113.    c.81 = -0.21E-79
  114.  
  115.    arg x,y  /* y soll "illegale" Komma's im Funktions-Argument aufspüren */
  116.    p0p=x*x /* Diese Anweisung prvoziert eine Syntax-Fehlermeldung       */
  117.  
  118.    if length(y) > 0 then
  119.    do
  120.      call charout(NDAga); Call SysFileDelete NDAga  /* hier ändern */
  121.      ret=LineOut(bufMsg, "Im Argument von  ga(...)  ist mindestens  1  nicht zulässiges Komma !")
  122.      /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  123.      /*  damit in den diesbezüglichen temporären Dateien                      */
  124.      /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  125.      EXIT
  126.    end
  127.  
  128.    if abs(x) > 3000 then
  129.    do
  130.      ret=LineOut(bufMsg, "Das Argument der Funktion  ga(...)  sollte ±3000 nicht überschreiten,",
  131.                          "         ",
  132.                          "weil sonst die Rechenzeit zu groß werden würde.")
  133.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  134.   /*  damit in den diesbezüglichen temporären Dateien                      */
  135.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  136.      EXIT
  137.    end
  138.  
  139.  
  140.  
  141. if x>0 then SIGNAL A; else SIGNAL B
  142.  
  143. A: xi=x%1; xd=x//1
  144.    uxi=1; i=1  /* Berechnung vom xi! */
  145.    do while  (i<xi)
  146.      uxi=uxi*i
  147.      i=i+1
  148.    end
  149.  
  150.    if xd=0 then do y=uxi; SIGNAL W; end
  151.  
  152.    u=0; n=1
  153.    do while n<82
  154.      g=(c.n)*(xd**n); u=u+g; n=n+1
  155.    end
  156.  
  157.    v=1; n=0
  158.    do while n<abs(xi)
  159.      g=(n+xd); v=v*g; n=n+1
  160.    end
  161.    y=v/u; SIGNAL W
  162.  
  163. B: xi=x%1-1; xd=1-abs(x//1)
  164.  
  165.    if abs(x//1)=0 then
  166.    do
  167.      call charout(NDAga); Call SysFileDelete NDAga  /* hier ändern */
  168.      ret=LineOut(bufMsg, "    Für  x=0  und für negative ganzzahlige Werte von x",
  169.                          "                        ",
  170.                          "    hat die Gammafunktion  ga(x)  Pole; sie ist dort nicht definiert.")
  171.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  172.   /*  damit in den diesbezüglichen temporären Dateien                      */
  173.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  174.      EXIT
  175.    end
  176.  
  177.    u=0; n=1
  178.    do while n<82
  179.      g=(c.n)*(xd**n); u=u+g; n=n+1
  180.    end
  181.  
  182.    v=1; n=1
  183.    do while n<abs(xi)+1
  184.      g=(xd-n); v=v*g; n=n+1
  185.    end
  186.    y=1/(v*u)
  187.  
  188.    /* Ausgabe */
  189. W: numeric digits ND
  190.    return(Format(y))
  191.  
  192.  
  193.  
  194. gaMsg:  /* hier ändern */
  195.    sf=ErrorText(RC)
  196.    if  Pos("Bad arithmetic conversion", sf) > 0 then
  197.    do
  198.      call charout(NDAga); Call SysFileDelete NDAga  /* hier ändern */
  199.      ret=LineOut(bufMsg, "Sie haben in  ga(...)  kein gültiges Argument eingegeben !")
  200.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  201.   /*  damit in den diesbezüglichen temporären Dateien                      */
  202.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  203.      EXIT
  204.    end
  205.  
  206.